home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / psion / s7.opl < prev    next >
Text File  |  1995-03-31  |  3KB  |  136 lines
  1. rem Copyright 1994, Juergen Weigert and Rudolf Koenig 
  2. rem Distribute freely and credit us, make profit and share with us. 
  3. rem email to jnweiger@immd4.informatik.uni-erlangen.de 
  4. rem Version 0.9 
  5.  
  6. proc main: 
  7.     global s7id%(2),s7ws%(2),s7hs%(2),s7ds%(10) 
  8.     global s7s%(6) 
  9.      
  10.     local frchd%, mode%, inter%, compl&, r% 
  11.      
  12.     s7init:(60, 140, 13) 
  13.      
  14.     r% = ioopen(frchd%, "FRC:", -1) 
  15.     if r% : raise r% : endif 
  16.     mode% = 1 : inter% = 1024 
  17.     iow(frchd%, 15, mode%, inter%) 
  18.  
  19.     gat 0, 15 
  20.     while 1 
  21.         s7number:(int(hour * 100 + minute) * 100 + second, 6, 2, 4) 
  22.         iow(frchd%, 1, compl&, compl&) 
  23.     endwh 
  24. endp 
  25.  
  26. proc s7number:(n&, nr%, col%, col2%) 
  27.   local ox%, oy%, x%, i%, j&, l%, jj% 
  28.    
  29.   j& = n& : l% = s7ws%(2) 
  30.   ox% = gx : oy% = gy 
  31.   x% = ox% + (s7ws%(1) + l%) * (nr% - 1) 
  32.   if col% 
  33.       x% = x% + 2 * l% 
  34.   endif 
  35.   if col2% 
  36.       x% = x% + 2 * l% 
  37.   endif 
  38.    
  39.   while i% < nr% 
  40.       gat x%, oy% 
  41.       jj% = j& - j& / 10 * 10 
  42.       s7digit:(i%+1, jj%) 
  43.       i% = i% + 1 
  44.       j& = j& / 10 
  45.       if col% = i% or col2% = i% 
  46.           x% = x% - 2 * l% 
  47.           gat x%, oy% + 2 * s7hs%(2) / 3 - l%/2 : gfill l%, l%, 0 
  48.           gat x%, oy% +     s7hs%(2)     + l%/2 : gfill l%, l%, 0 
  49.       endif 
  50.       x% = x% - s7ws%(1) - l% 
  51.   endwh 
  52.   gat ox%, oy% 
  53. endp 
  54.  
  55. proc s7digit:(idx%, n%) 
  56.     local i%, j% 
  57.      
  58.     if s7ds%(n%+1) = s7s%(idx%) 
  59.         return 
  60.     endif 
  61.      
  62.     i% = 1 : j% = 1 
  63.     while j% < 8 
  64.         if (s7ds%(n%+1) AND i%) <> (s7s%(idx%) AND i%) 
  65.             s7seg:(j%) 
  66.         endif 
  67.         i% = i% * 2 
  68.         j% = j% + 1 
  69.     endwh 
  70.     s7s%(idx%) = s7ds%(n%+1) 
  71. endp 
  72.  
  73. PROC s7seg:(n%) 
  74.     local x%, y%, i% 
  75.  
  76.     x%=gx 
  77.     y%=gy 
  78.     if n%=2 or n%=4 
  79.         gat x%+s7ws%(1)-s7ws%(2), gy 
  80.     endif 
  81.     if n%=3 or n%=4 or n%=6 or n%=7 
  82.         gat gx, y%+s7hs%(2)-s7hs%(1) 
  83.     endif 
  84.     if n%=7 
  85.         gat gx, gy+s7hs%(2)-s7hs%(1) 
  86.     endif 
  87.     i%=2 
  88.     if n%>4 
  89.         i%=1 
  90.     endif 
  91.     gcopy s7id%(i%), 0,0, s7ws%(i%), s7hs%(i%),2 
  92.     gat x%, y% 
  93. ENDP 
  94.  
  95. proc s7init:(w%,hh%,i%) 
  96.     local d%,x%,h%,oldid%,j% 
  97.  
  98.     oldid%=gidentity 
  99.     d%=i%/2 
  100.     h%=hh%/2 
  101.      
  102.     s7id%(1)=gcreatebit(w%,i%) :gcls 
  103.     s7ws%(1)=w% : s7hs%(1)=i% 
  104.     j%=i%/2 
  105.     while j%>=0 
  106.         gat i%-j%,j% :glineto i%-j%, i%-j% 
  107.         gat w%-i%+j%-1,j% :glineto w%-i%+j%-1, i%-j% 
  108.         j%=j%-1 
  109.     endwh 
  110.     gat i%,0 :gfill w%-i%-i%,i%,0 
  111.      
  112.     s7id%(2)=gcreatebit(i%,h%) :gcls 
  113.     s7ws%(2)=i% : s7hs%(2)=h% 
  114.     j%=i%/2 
  115.     while j%>=0 
  116.         gat j%,i%-j% :glineto i%-j%, i%-j% 
  117.         gat j%,h%-i%+j%-1 :glineto i%-j%,h%-i%+j%-1 
  118.         j%=j%-1 
  119.     endwh 
  120.     gat 0,i% :gfill i%,h%-i%-i%,0 
  121.      
  122.     guse oldid% 
  123.  
  124. rem segment pattern for digits 
  125.     s7ds%(1)=$5f 
  126.     s7ds%(2)=$0a 
  127.     s7ds%(3)=$76 
  128.     s7ds%(4)=$7a 
  129.     s7ds%(5)=$2b 
  130.     s7ds%(6)=$79 
  131.     s7ds%(7)=$7d 
  132.     s7ds%(8)=$1a 
  133.     s7ds%(9)=$7f 
  134.     s7ds%(10)=$7b 
  135. endp 
  136.